home *** CD-ROM | disk | FTP | other *** search
/ Delphi Magazine Collection 2001 / Delphi Magazine Collection 20001 (2001).iso / DISKS / Issue50 / IPC / File Mappings / API / ParentMainFormUnit.pas < prev    next >
Encoding:
Pascal/Delphi Source File  |  1999-08-28  |  2.2 KB  |  97 lines
  1. unit ParentMainFormUnit;
  2.  
  3. interface
  4.  
  5. uses
  6.   Windows, Messages, SysUtils, Classes, Graphics, Controls, Forms, Dialogs,
  7.   ExtCtrls, StdCtrls;
  8.  
  9. type
  10.   TForm1 = class(TForm)
  11.     Memo1: TMemo;
  12.     Timer1: TTimer;
  13.     procedure FormCreate(Sender: TObject);
  14.     procedure FormDestroy(Sender: TObject);
  15.     procedure Timer1Timer(Sender: TObject);
  16.   private
  17.     { Private declarations }
  18.   public
  19.     MemMapFile: THandle;
  20.     MemMapFileBuffer: Pointer;
  21.   end;
  22.  
  23. {$ifdef Ver90}
  24.   //This exception class did not exist in Delphi 2
  25.   EWin32Error = class(Exception);
  26. {$endif}
  27.  
  28. var
  29.   Form1: TForm1;
  30.  
  31. const
  32.   MemMapFileName = 'SampleMemoryMappedFile';
  33.   MemMapSize = 1000;
  34.  
  35. implementation
  36.  
  37. {$R *.DFM}
  38.  
  39. {$ifdef Ver90}
  40. //This function class did not exist in Delphi 2
  41. function Win32Check(RetVal: Bool): Bool;
  42. var
  43.   LastError: DWord;
  44. begin
  45.   Result := RetVal;
  46.   if not RetVal then
  47.   begin
  48.     LastError := GetLastError;
  49.     if LastError <> Error_Success then
  50.       raise EWin32Error.CreateFmt( 'Win32 Error.  Code: %d.'#10'%s',
  51.         [LastError, SysErrorMessage(LastError)])
  52.     else
  53.       raise EWin32Error.Create('A Win32 API function failed')
  54.   end;
  55. end;
  56. {$endif}
  57.  
  58. function LaunchChildApp: THandle;
  59. const
  60.   ChildApp = 'ChildMemoryMappedFile.Exe';
  61. var
  62.   SI: TStartupInfo;
  63.   PI: TProcessInformation;
  64. begin
  65.   GetStartupInfo(SI);
  66.   if not CreateProcess(nil, ChildApp, nil, nil, False,
  67.      0, nil, nil, SI, PI) then
  68.     raise EWin32Error.Create('Unable to launch ' + ChildApp);
  69.   Result := PI.HProcess
  70. end;
  71.  
  72. procedure TForm1.FormCreate(Sender: TObject);
  73. begin
  74.   //$FFFFFFFF causes CreateFileMapping to make a shared
  75.   //memory-mapped file which is stored, if
  76.   //it becomes necessary, in the OS swap file
  77.   MemMapFile := CreateFileMapping($FFFFFFFF, nil, Page_ReadWrite, 0,
  78.     MemMapSize, MemMapFileName);
  79.   Win32Check(Bool(MemMapFile));
  80.   MemMapFileBuffer := MapViewOfFile(MemMapFile, File_Map_Write, 0, 0, MemMapSize);
  81.   Win32Check(Bool(MemMapFileBuffer));
  82.   LaunchChildApp;
  83. end;
  84.  
  85. procedure TForm1.FormDestroy(Sender: TObject);
  86. begin
  87.   CloseHandle(MemMapFile)
  88. end;
  89.  
  90. procedure TForm1.Timer1Timer(Sender: TObject);
  91. begin
  92.   if PChar(MemMapFileBuffer)[0] <> #0 then
  93.     Memo1.Text := StrPas(PChar(MemMapFileBuffer))
  94. end;
  95.  
  96. end.
  97.